home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 2: CDPD 1
/
Almathera Ten on Ten - Disc 2: CDPD 1.iso
/
pd
/
076-100
/
084
/
gravitywars
/
console.mod
< prev
next >
Wrap
Text File
|
1995-03-13
|
9KB
|
253 lines
IMPLEMENTATION MODULE Console;
(**********************************************************************
*************** Written by Ed Bartz ***************
*************** Copyright 5/21/87 ***************
*************** This program may be redistributed ***************
*************** or modified as long as these ***************
*************** notices and all other references ***************
*************** to the author remain intack. ***************
*************** Also this may not be used for ***************
*************** profit by anyone without the ***************
*************** express permission of the author. ***************
**********************************************************************)
FROM IO IMPORT IOStdReqPtr, DoIO, SendIO, CmdRead, CmdWrite, AbortIO;
FROM PortUtils IMPORT CreatePort,DeletePort,CreateStdIO,DeleteStdIO;
FROM Ports IMPORT WaitPort, MsgPortPtr, MessagePtr, GetMsg;
FROM Intuition IMPORT WindowPtr;
FROM Devices IMPORT OpenDevice, CloseDevice;
FROM SYSTEM IMPORT ADR, NULL;
(*+,+*)
PROCEDURE QueueRead(VAR Rport: Conport);
(* queue up a read request to a console, show where to
* put the character when ready to be returned. Most
* efficient if this is called right after console is
* opened *)
BEGIN
Rport.IO^.ioReq.ioCommand := CmdRead;
Rport.IO^.ioData := ADR(Rport.buf[0]);
Rport.IO^.ioLength := 1;
SendIO(Rport.IO^.ioReq);
END QueueRead;
PROCEDURE OpenWRConsole(VAR Wport, Rport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
VAR
i : INTEGER;
error :LONGCARD;
err : BOOLEAN;
c : CHAR;
BEGIN
error:=1;
Wport.msg := CreatePort("my.con.write",0);
Wport.IO := CreateStdIO(Wport.msg);
Rport.msg := CreatePort("my.con.read",0);
Rport.IO := CreateStdIO(Rport.msg);
IF NOT((Wport.msg=NULL)OR(Wport.IO=NULL)OR(Rport.msg=NULL)OR(Rport.IO=NULL))THEN
Wport.IO^.ioData:= w;
Wport.IO^.ioLength := SIZE(w^);
error := OpenDevice("console.device", 0, Wport.IO, 0);
Rport.IO^.ioReq.ioDevice := Wport.IO^.ioReq.ioDevice;
Rport.IO^.ioReq.ioUnit := Wport.IO^.ioReq.ioUnit;
(* clone required parts of the request *)
END;
IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
QueueRead(Rport);
FOR i := 0 TO 79 DO
Rport.buf[i]:= 0C;
Wport.buf[i]:= 0C;
END;
RETURN err
END OpenWRConsole;
PROCEDURE OpenWConsole(VAR Wport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
VAR
i : INTEGER;
error :LONGCARD;
err : BOOLEAN;
c : CHAR;
BEGIN
error:=1;
Wport.msg := CreatePort("my.con.write",0);
Wport.IO := CreateStdIO(Wport.msg);
IF NOT((Wport.msg=NULL)OR(Wport.IO=NULL))THEN
Wport.IO^.ioData:= w;
Wport.IO^.ioLength := SIZE(w^);
error := OpenDevice("console.device", 0, Wport.IO, 0);
END;
IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
FOR i := 0 TO 79 DO
Wport.buf[i]:= 0C;
END;
RETURN err
END OpenWConsole;
PROCEDURE OpenRConsole(VAR Rport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
VAR
i : INTEGER;
error :LONGCARD;
err : BOOLEAN;
c : CHAR;
BEGIN
error:=1;
Rport.msg := CreatePort("my.con.read",0);
Rport.IO := CreateStdIO(Rport.msg);
IF NOT((Rport.msg=NULL)OR(Rport.IO=NULL))THEN
Rport.IO^.ioData:= w;
Rport.IO^.ioLength := SIZE(w^);
error := OpenDevice("console.device", 0, Rport.IO, 0);
END;
IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
IF err THEN QueueRead(Rport); END;
FOR i := 0 TO 79 DO
Rport.buf[i]:= 0C;
END;
RETURN err
END OpenRConsole;
PROCEDURE CloseWRConsole(Wport, Rport: Conport);
BEGIN
AbortIO(Rport.IO^.ioReq);
CloseDevice(Wport.IO);
DeleteStdIO(Wport.IO);
DeleteStdIO(Rport.IO);
DeletePort(Wport.msg);
DeletePort(Rport.msg);
END CloseWRConsole;
PROCEDURE CloseWConsole(Wport: Conport);
BEGIN
CloseDevice(Wport.IO);
DeleteStdIO(Wport.IO);
DeletePort(Wport.msg);
END CloseWConsole;
PROCEDURE CloseRConsole(Rport: Conport);
BEGIN
AbortIO(Rport.IO^.ioReq);
CloseDevice(Rport.IO);
DeleteStdIO(Rport.IO);
DeletePort(Rport.msg);
END CloseRConsole;
PROCEDURE PutChar(Wport: Conport; c: CHAR);
(* Output a single character to a specified console *)
VAR
i : LONGINT;
BEGIN
Wport.IO^.ioReq.ioCommand := CmdWrite;
Wport.IO^.ioData := ADR(c);
Wport.IO^.ioLength := 1;
i:=DoIO(Wport.IO^.ioReq);
(* command works because DoIO blocks until command is
* done (otherwise pointer to the character could become
* invalid in the meantime).
*)
END PutChar;
PROCEDURE Writestr(Wport: Conport; VAR s: ARRAY OF CHAR; len: LONGINT);
(* Output a stream of known length to a console *)
VAR
i : LONGINT;
BEGIN
Wport.IO^.ioReq.ioCommand := CmdWrite;
Wport.IO^.ioData := ADR(s);
Wport.IO^.ioLength := len;
i:=DoIO(Wport.IO^.ioReq);
(* command works because DoIO blocks until command is
* done (otherwise pointer to string could become
* invalid in the meantime).
*)
END Writestr;
PROCEDURE PutStr(Wport: Conport; VAR s: ARRAY OF CHAR);
(* Output a NULL-terminated string of characters to a console *)
VAR
i : LONGINT;
BEGIN
Wport.IO^.ioReq.ioCommand := CmdWrite;
Wport.IO^.ioData := ADR(s);
Wport.IO^.ioLength := MAX (LONGCARD);
(* tells console to end when it
* sees a terminating zero on
* the string. *)
i:=DoIO(Wport.IO^.ioReq);
END PutStr;
PROCEDURE MayGetChar(VAR Rport: Conport; VAR c: CHAR): BOOLEAN;
(* see if there is a character to read. If none, don't wait,
* come back with a value of FALSE *)
BEGIN
IF (GetMsg(Rport.msg)=MessagePtr(0))THEN RETURN FALSE;
ELSE
QueueRead(Rport);
c:= Rport.buf[0];
RETURN TRUE;
END;
END MayGetChar;
PROCEDURE GetChar(VAR Rport: Conport; VAR c: CHAR);
(* go and get a character; put the task to sleep if
there isn't one present *)
VAR
i : MessagePtr;
BEGIN
WHILE GetMsg(Rport.msg) = MessagePtr(0) DO
IF WaitPort(Rport.msg) = MessagePtr(0) THEN END;
END;
QueueRead(Rport);
c:= Rport.buf[0];
END GetChar;
PROCEDURE GetStr(VAR Rport, Wport: Conport; VAR s: ARRAY OF CHAR): BOOLEAN;
VAR
i,j : INTEGER;
str : ARRAY [0..80] OF CHAR;
c : CHAR;
BEGIN
i:=0;
c:=' ';
QueueRead(Rport);
WHILE ((i<79)AND(c#15C)) DO
GetChar(Rport,c);
s[i] := c;
IF c #15C THEN
IF (c=10C)OR(c=177C) THEN
c:=10C;
i:=i-2;
IF i<(-1) THEN i:=(-1);END;
END;
i:=i+1;
PutChar(Wport,c);
END;
END;
QueueRead(Rport);
IF i#0 THEN
s[i]:=0C;
RETURN TRUE;
END;
RETURN FALSE;
END GetStr;
END Console.